home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tests / help.test < prev    next >
Encoding:
Text File  |  1994-01-23  |  6.8 KB  |  251 lines
  1. #
  2. # help.test
  3. #
  4. # Tests for the help subsystem.  Help must be build first.  If help files
  5. # change, thest tests may have to be changed.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: help.test,v 3.1 1994/01/23 16:58:20 markd Exp $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] != "test"} then {source testlib.tcl}
  21.  
  22. #
  23. # Only run help test if help has been installed.
  24. #
  25. if {"[glob -nocomplain ../tclmaster/help/*]" == ""} {
  26.     echo "****"
  27.     echo "**** No help pages in tclmaster/help - help test not run"
  28.     echo "****"
  29.     return
  30. }
  31.  
  32. #
  33. # Fork without exec will not work under Tk, skip this test
  34. #
  35. if ![lempty [info commands button]] {
  36.     puts stderr "*************************************************************"
  37.     puts stderr "Help tests are constructed in a way that does not work"
  38.     puts stderr "under Tk.  Test skipped."
  39.     puts stderr "*************************************************************"
  40.     puts stderr ""
  41.     return
  42. }
  43.  
  44. #------------------------------------------------------------------------------
  45. # Read a line from the server, set an alarm to make sure it doesn't hang.
  46. proc ReadServer {} {
  47.     global G_helpOutPipeFH
  48.  
  49.     alarm 45
  50.     if {[gets $G_helpOutPipeFH line] < 0} {
  51.         alarm 0
  52.         error "EOF from help server"}
  53.     alarm 0
  54.     return $line
  55. }
  56.  
  57. #------------------------------------------------------------------------------
  58. # Eat a prompt line from the help server.
  59.  
  60. proc EatServerPrompt {} {
  61.     set line [ReadServer]
  62.     if {"$line" != "===HELPSERVER==="} {
  63.         error "unexpected output from help server: `$line'"}
  64. }
  65.  
  66. #------------------------------------------------------------------------------
  67. # Send a command to the help server and return the output.  The help server
  68. # output will be bracketed with commands to mark the beginning and ending.
  69. # An extra newline is always queued to continue the help pager.  The prompt of
  70. # the pager will be removed from the output.  This assumes that the output has
  71. # no lines starting with `:'.
  72. #
  73. proc HelpSend {cmd pagerCntVar} {
  74.     global G_helpInPipeFH G_helpOutPipeFH
  75.     upvar $pagerCntVar pagerCnt
  76.  
  77.     puts $G_helpInPipeFH $cmd
  78.     puts $G_helpInPipeFH ""  ;# Just a new line..
  79.     flush $G_helpInPipeFH
  80.  
  81.     set pagerCnt 0
  82.     set results {}
  83.  
  84.     # Read lines of the output.
  85.     while 1 {
  86.         set line [ReadServer]
  87.         if {"[cindex $line 0]" == ":"} {
  88.             set line [crange $line 1 end]
  89.             incr pagerCnt
  90.             puts $G_helpInPipeFH ""  ;# Just a new line
  91.         }
  92.         if {"$line" == "===HELPSERVER==="} {
  93.             break}
  94.         append results $line "\n"
  95.     }
  96.     # Eat the extra prompt caused by the typed-ahead newline
  97.     EatServerPrompt
  98.  
  99.     return $results
  100. }
  101. #
  102. # Create the help server process, which will execute the commands, 
  103. # with stdin and stdout redirected to pipes.
  104. #
  105.  
  106. global G_helpInPipeFH G_helpOutPipeFH G_helpPid
  107.  
  108. pipe fromClientPipeFH G_helpInPipeFH
  109. pipe G_helpOutPipeFH  toClientPipeFH
  110.  
  111. fcntl $G_helpInPipeFH  NOBUF 1
  112. fcntl $G_helpOutPipeFH NOBUF 1
  113.  
  114. flush stdout  ;# Not going to exec, must clean up the buffers.
  115. flush stderr
  116. set G_helpPid [fork]
  117.  
  118. if {$G_helpPid == 0} {
  119.     close stdin
  120.     dup $fromClientPipeFH stdin
  121.     close stdout
  122.     dup $toClientPipeFH stdout
  123.     close $G_helpInPipeFH
  124.     close $G_helpOutPipeFH
  125.  
  126.     eval $SAVED_UNKNOWN
  127.  
  128.     commandloop {puts stdout "===HELPSERVER==="; flush stdout} \
  129.                 {error "Help server incomplete cmd"}
  130.     error "Help server got eof"
  131. }
  132.  
  133. close $fromClientPipeFH
  134. close $toClientPipeFH
  135.  
  136. #
  137. # An alarm will be set when talking to the server uncase it doesn't talk back
  138. #
  139. signal error SIGALRM
  140.  
  141. # Nuke the first prompt
  142. EatServerPrompt
  143.  
  144. # Now run the tests.
  145.  
  146.  
  147. Test help-1.1 {help tests} {
  148.     HelpSend "help" promptCnt
  149. } 0 {
  150. Subjects available in /:
  151.    tcl/
  152.  
  153. Help pages available in /:
  154.    help
  155. }
  156.  
  157. Test help-1.1.1 {help tests} {
  158.     HelpSend "help tcl" promptCnt
  159. } 0 {
  160. Subjects available in /tcl:
  161.    control/         debug/           files/           filescan/
  162.    internation/     intro/           keyedlists/      libraries/
  163.    lists/           math/            processes/       signals/
  164.    status/          strings/         tclshell/        time/
  165.    variables/
  166. }
  167.  
  168. Test help-1.2 {help tests} {
  169.     HelpSend "helppwd" promptCnt
  170. } 0 {Current help subject: /
  171. }
  172.  
  173. Test help-1.3 {help tests} {
  174.     HelpSend "helpcd tcl/filescan" promptCnt
  175. } 0 {}
  176.  
  177. Test help-1.4 {help tests} {
  178.     HelpSend "helppwd" promptCnt
  179. } 0 {Current help subject: /tcl/filescan
  180. }
  181.  
  182. Test help-1.5 {help tests} {
  183.     set result [HelpSend "help /tcl/lists/lassign" promptCnt]
  184.     set fh [open "../tclmaster/help/tcl/lists/lassign"]
  185.     set expect [read $fh]
  186.     close $fh
  187.     set summary {}
  188.     if {"$expect" == "$result"} {
  189.         append summary "CORRECT"
  190.     } else {
  191.         append summary "DATA DOES NOT MATCH : $result"
  192.     }
  193.     if {$promptCnt == 0} {
  194.        append summary " : PROMPT OK"
  195.     } else {
  196.        append summary " : TOO MANY PROMPTS: $promptCnt"
  197.     }
  198.     set summary
  199. } 0 {CORRECT : PROMPT OK}
  200.  
  201. Test help-1.6 {help tests} {
  202.     set result [HelpSend "help /tcl/math/expr" promptCnt]
  203.     set fh [open "../tclmaster/help/tcl/math/expr"]
  204.     set expect [read $fh]
  205.     close $fh
  206.     set summary {}
  207.     if {"$expect" == "$result"} {
  208.         append summary "CORRECT"
  209.     } else {
  210.         append summary "DATA DOES NOT MATCH: $result"
  211.     }
  212.     if {$promptCnt >= 2} {
  213.        append summary " : PROMPT OK"
  214.     } else {
  215.        append summary " : NOT ENOUGH PROMPTS: $promptCnt"
  216.     }
  217.     set summary
  218. } 0 {CORRECT : PROMPT OK}
  219.  
  220. Test help-1.7 {help tests} {
  221.     HelpSend "apropos upvar" promptCnt
  222. } 0 {tcl/variables/upvar - Create link to variable in a different stack frame
  223. }
  224.  
  225. Test help-1.8 {help tests} {
  226.     HelpSend "apropos clock" promptCnt
  227. } 0 {tcl/time/alarm - Set a process alarm clock.
  228. tcl/time/convertclock - Parse and convert a date and time string to integer clock value.
  229. tcl/time/fmtclock - Convert an integer time value to human-readable format.
  230. tcl/time/getclock - Return current date and time as an integer value.
  231. }
  232.  
  233. Test help-1.9 {help tests} {
  234.     HelpSend "helpcd" promptCnt
  235. } 0 {}
  236.  
  237. Test help-1.10 {help tests} {
  238.     HelpSend "helppwd" promptCnt
  239. } 0 {Current help subject: /
  240. }
  241.  
  242.  
  243. # Terminate the help server.
  244.  
  245. puts $G_helpInPipeFH "exit 0"
  246. set status [wait $G_helpPid]
  247. if {"$status" != "$G_helpPid EXIT 0"} {
  248.     error "Bad status returned: `$status'"}
  249.  
  250. return
  251.